unit DLLLoader;

interface

uses Windows, Classes, Zlib;
{$REGION ' const '}
const
  IMPORTED_NAME_OFFSET = $00000002;
  IMAGE_ORDINAL_FLAG32 = $80000000;
  IMAGE_ORDINAL_MASK32 = $0000FFFF;
  RTL_CRITSECT_TYPE = 0;
  RTL_RESOURCE_TYPE = 1;
  DLL_PROCESS_ATTACH = 1;
  DLL_THREAD_ATTACH = 2;
  DLL_THREAD_DETACH = 3;
  DLL_PROCESS_DETACH = 0;
  IMAGE_SizeHeader = 20;
  IMAGE_FILE_RELOCS_STRIPPED = $0001;
  IMAGE_FILE_EXECUTABLE_IMAGE = $0002;
  IMAGE_FILE_LINE_NUMS_STRIPPED = $0004;
  IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008;
  IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010;
  IMAGE_FILE_BYTES_REVERSED_LO = $0080;
  IMAGE_FILE_32BIT_MACHINE = $0100;
  IMAGE_FILE_DEBUG_STRIPPED = $0200;
  IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400;
  IMAGE_FILE_NET_RUN_FROM_SWAP = $0800;
  IMAGE_FILE_SYSTEM = $1000;
  IMAGE_FILE_DLL = $2000;
  IMAGE_FILE_UP_SYSTEM_ONLY = $4000;
  IMAGE_FILE_BYTES_REVERSED_HI = $8000;
  IMAGE_FILE_MACHINE_UNKNOWN = 0;
  IMAGE_FILE_MACHINE_I386 = $14C;
  IMAGE_FILE_MACHINE_R3000 = $162;
  IMAGE_FILE_MACHINE_R4000 = $166;
  IMAGE_FILE_MACHINE_R10000 = $168;
  IMAGE_FILE_MACHINE_ALPHA = $184;
  IMAGE_FILE_MACHINE_POWERPC = $1F0;
  IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
  IMAGE_SUBSYSTEM_UNKNOWN = 0;
  IMAGE_SUBSYSTEM_NATIVE = 1;
  IMAGE_SUBSYSTEM_WINDOWS_GUI = 2;
  IMAGE_SUBSYSTEM_WINDOWS_CUI = 3;
  IMAGE_SUBSYSTEM_OS2_CUI = 5;
  IMAGE_SUBSYSTEM_POSIX_CUI = 7;
  IMAGE_SUBSYSTEM_RESERVED = 8;
  IMAGE_DIRECTORY_ENTRY_EXPORT = 0;
  IMAGE_DIRECTORY_ENTRY_IMPORT = 1;
  IMAGE_DIRECTORY_ENTRY_RESOURCE = 2;
  IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3;
  IMAGE_DIRECTORY_ENTRY_SECURITY = 4;
  IMAGE_DIRECTORY_ENTRY_BASERELOC = 5;
  IMAGE_DIRECTORY_ENTRY_DEBUG = 6;
  IMAGE_DIRECTORY_ENTRY_COPYRIGHT = 7;
  IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8;
  IMAGE_DIRECTORY_ENTRY_TLS = 9;
  IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10;
  IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11;
  IMAGE_DIRECTORY_ENTRY_IAT = 12;
  IMAGE_SIZEOF_SHORT_NAME = 8;
  IMAGE_SCN_TYIMAGE_REG = $00000000;
  IMAGE_SCN_TYIMAGE_DSECT = $00000001;
  IMAGE_SCN_TYIMAGE_NOLOAD = $00000002;
  IMAGE_SCN_TYIMAGE_GROUP = $00000004;
  IMAGE_SCN_TYIMAGE_NO_PAD = $00000008;
  IMAGE_SCN_TYIMAGE_COPY = $00000010;
  IMAGE_SCN_CNT_CODE = $00000020;
  IMAGE_SCN_CNT_INITIALIZED_DATA = $00000040;
  IMAGE_SCN_CNT_UNINITIALIZED_DATA = $00000080;
  IMAGE_SCN_LNK_OTHER = $00000100;
  IMAGE_SCN_LNK_INFO = $00000200;
  IMAGE_SCN_TYIMAGE_OVER = $0000400;
  IMAGE_SCN_LNK_REMOVE = $00000800;
  IMAGE_SCN_LNK_COMDAT = $00001000;
  IMAGE_SCN_MEM_PROTECTED = $00004000;
  IMAGE_SCN_MEM_FARDATA = $00008000;
  IMAGE_SCN_MEM_SYSHEAP = $00010000;
  IMAGE_SCN_MEM_PURGEABLE = $00020000;
  IMAGE_SCN_MEM_16BIT = $00020000;
  IMAGE_SCN_MEM_LOCKED = $00040000;
  IMAGE_SCN_MEM_PRELOAD = $00080000;
  IMAGE_SCN_ALIGN_1BYTES = $00100000;
  IMAGE_SCN_ALIGN_2BYTES = $00200000;
  IMAGE_SCN_ALIGN_4BYTES = $00300000;
  IMAGE_SCN_ALIGN_8BYTES = $00400000;
  IMAGE_SCN_ALIGN_16BYTES = $00500000;
  IMAGE_SCN_ALIGN_32BYTES = $00600000;
  IMAGE_SCN_ALIGN_64BYTES = $00700000;
  IMAGE_SCN_LNK_NRELOC_OVFL = $01000000;
  IMAGE_SCN_MEM_DISCARDABLE = $02000000;
  IMAGE_SCN_MEM_NOT_CACHED = $04000000;
  IMAGE_SCN_MEM_NOT_PAGED = $08000000;
  IMAGE_SCN_MEM_SHARED = $10000000;
  IMAGE_SCN_MEM_EXECUTE = $20000000;
  IMAGE_SCN_MEM_READ = $40000000;
  IMAGE_SCN_MEM_WRITE = LONGWORD($80000000);
  IMAGE_REL_BASED_ABSOLUTE = 0;
  IMAGE_REL_BASED_HIGH = 1;
  IMAGE_REL_BASED_LOW = 2;
  IMAGE_REL_BASED_HIGHLOW = 3;
  IMAGE_REL_BASED_HIGHADJ = 4;
  IMAGE_REL_BASED_MIPS_JMPADDR = 5;
  IMAGE_REL_BASED_SECTION = 6;
  IMAGE_REL_BASED_REL32 = 7;
  IMAGE_REL_BASED_MIPS_JMPADDR16 = 9;
  IMAGE_REL_BASED_IA64_IMM64 = 9;
  IMAGE_REL_BASED_DIR64 = 10;
  IMAGE_REL_BASED_HIGH3ADJ = 11;
  PAGE_NOACCESS = 1;
  PAGE_READONLY = 2;
  PAGE_READWRITE = 4;
  PAGE_WRITECOPY = 8;
  PAGE_EXECUTE = $10;
  PAGE_EXECUTE_READ = $20;
  PAGE_EXECUTE_READWRITE = $40;
  PAGE_EXECUTE_WRITECOPY = $80;
  PAGE_GUARD = $100;
  PAGE_NOCACHE = $200;
  MEM_COMMIT = $1000;
  MEM_RESERVE = $2000;
  MEM_DECOMMIT = $4000;
  MEM_RELEASE = $8000;
  MEM_FREE = $10000;
  MEM_PRIVATE = $20000;
  MEM_MAPPED = $40000;
  MEM_RESET = $80000;
  MEM_TOP_DOWN = $100000;
  SEC_FILE = $800000;
  SEC_IMAGE = $1000000;
  SEC_RESERVE = $4000000;
  SEC_COMMIT = $8000000;
  SEC_NOCACHE = $10000000;
  MEM_IMAGE = SEC_IMAGE;
{$ENDREGION}

{$REGION ' types '}
type
  PPOINTER = ^POINTER;
  PLONGWORD = ^LONGWORD;
  PPLONGWORD = ^PLONGWORD;
  PWORD = ^WORD;
  PPWORD = ^PWORD;
  HINST = LONGWORD;
  HMODULE = HINST;
  PWordArray = ^TWordArray;
  TWordArray = array[0..(2147483647 div SIZEOF(WORD)) - 1] of WORD;
  PLongWordArray = ^TLongWordArray;
  TLongWordArray = array[0..(2147483647 div SIZEof(LONGWORD)) - 1] of LONGWORD;
  PImageDOSHeader = ^TImageDOSHeader;
  TImageDOSHeader = packed record
    Signature,
      PartPag,
      PageCnt,
      ReloCnt,
      HdrSize,
      MinMem,
      MaxMem,
      ReloSS,
      ExeSP,
      ChkSum,
      ExeIP,
      ReloCS,
      Tabloff,
      Overlay: WORD;
    Reserved: packed array[0..3] of WORD;
    OEMID,
      OEMInfo: WORD;
    Reserved2: packed array[0..9] of WORD;
    LFAoffset: LONGWORD;
  end;

  TISHMisc = packed record
    case integer of
      0: (PhysicalAddress: LONGWORD);
      1: (VirtualSize: LONGWORD);
  end;

  PImageExportDirectory = ^TImageExportDirectory;
  TImageExportDirectory = packed record
    Characteristics,
      TimeDateStamp: LONGWORD;
    MajorVersion,
      MinorVersion: WORD;
    Name,
      Base,
      NumberofFunctions,
      NumberofNames: LONGWORD;
    AddressofFunctions,
      AddressofNames: PPLONGWORD;
    AddressofNameOrdinals: PPWORD;
  end;

  PImageSectionHeader = ^TImageSectionHeader;
  TImageSectionHeader = packed record
    Name: packed array[0..IMAGE_SIZEof_SHORT_NAME - 1] of BYTE;
    Misc: TISHMisc;
    VirtualAddress,
      SizeofRawData,
      PointerToRawData,
      PointerToRelocations,
      PointerToLinenumbers: LONGWORD;
    NumberofRelocations,
      NumberofLinenumbers: WORD;
    Characteristics: LONGWORD;
  end;

  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = array[0..(2147483647 div SIZEof(TImageSectionHeader)) - 1] of TImageSectionHeader;

  PImageDataDirectory = ^TImageDataDirectory;
  TImageDataDirectory = packed record
    VirtualAddress,
      Size: LONGWORD;
  end;

  PImageFileHeader = ^TImageFileHeader;
  TImageFileHeader = packed record
    Machine,
      NumberofSections: WORD;
    TimeDateStamp,
      PointerToSymbolTable,
      NumberofSymbols: LONGWORD;
    SizeofOptionalHeader,
      Characteristics: WORD;
  end;

  PImageOptionalHeader = ^TImageOptionalHeader;
  TImageOptionalHeader = packed record
    Magic: WORD;
    MajorLinkerVersion,
      MinorLinkerVersion: BYTE;
    SizeofCode,
      SizeofInitializedData,
      SizeofUninitializedData,
      AddressofEntryPoint,
      BaseofCode,
      BaseofData,
      ImageBase,
      SectionAlignment,
      FileAlignment: LONGWORD;
    MajorOperatingSystemVersion,
      MinorOperatingSystemVersion,
      MajorImageVersion,
      MinorImageVersion,
      MajorSubsystemVersion,
      MinorSubsystemVersion: WORD;
    Win32VersionValue,
      SizeofImage,
      SizeofHeaders,
      CheckSum: LONGWORD;
    Subsystem,
      DllCharacteristics: WORD;
    SizeofStackReserve,
      SizeofStackCommit,
      SizeofHeapReserve,
      SizeofHeapCommit,
      LoaderFlags,
      NumberofRvaAndSizes: LONGWORD;
    DataDirectory: packed array[0..IMAGE_NUMBERof_DIRECTORY_ENTRIES - 1] of TImageDataDirectory;
  end;

  PImageNTHeaders = ^TImageNTHeaders;
  TImageNTHeaders = packed record
    Signature: LONGWORD;
    FileHeader: TImageFileHeader;
    OptionalHeader: TImageOptionalHeader;
  end;

  PImageImportDescriptor = ^TImageImportDescriptor;
  TImageImportDescriptor = packed record
    OriginalFirstThunk,
      TimeDateStamp,
      ForwarderChain,
      Name,
      FirstThunk: LONGWORD;
  end;

  PImageBaseRelocation = ^TImageBaseRelocation;
  TImageBaseRelocation = packed record
    VirtualAddress,
      SizeofBlock: LONGWORD;
  end;

  PImageThunkData = ^TImageThunkData;
  TImageThunkData = packed record
    ForwarderString,
      Funktion,
      Ordinal,
      AddressofData: LONGWORD;
  end;

  PSection = ^TSection;
  TSection = packed record
    Base: POINTER;
    RVA,
      Size,
      Characteristics: LONGWORD;
  end;

  TSections = array of TSection;

  TDLLEntryProc = function(hinstDLL: HMODULE; dwReason: LONGWORD; lpvReserved: POINTER): boolean; STDCALL;

  TNameOrID = (niName, niID);

  TExternalLibrary = record
    LibraryName: string;
    LibraryHandle: HINST;
  end;

  TExternalLibrarys = array of TExternalLibrary;

  PDLLfunctionImport = ^TDLLfunctionImport;
  TDLLfunctionImport = record
    NameOrID: TNameOrID;
    Name: string;
    ID: integer;
  end;

  PDLLImport = ^TDLLImport;
  TDLLImport = record
    LibraryName: string;
    LibraryHandle: HINST;
    Entries: array of TDLLfunctionImport;
  end;

  TImports = array of TDLLImport;

  PDLLfunctionExport = ^TDLLfunctionExport;
  TDLLfunctionExport = record
    Name: string;
    Index: integer;
    functionPointer: POINTER;
  end;

  TExports = array of TDLLfunctionExport;

  TExportTreeLink = POINTER;

  PExportTreeNode = ^TExportTreeNode;
  TExportTreeNode = record
    TheChar: CHAR;
    Link: TExportTreeLink;
    LinkExist: boolean;
    Prevoius, Next, Up, Down: PExportTreeNode;
  end;

  TExportTree = class
  private
    Root: PExportTreeNode;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Dump;
    function Add(functionName: string; Link: TExportTreeLink): boolean;
    function Delete(functionName: string): boolean;
    function Find(functionName: string; var Link: TExportTreeLink): boolean;
  end;

  TDLLLoader = class
  private
    ImageBase: POINTER;
    ImageBaseDelta: integer;
    DLLProc: TDLLEntryProc;
    ExternalLibraryarray: TExternalLibrarys;
    Importarray: TImports;
    Exportarray: TExports;
    Sections: TSections;
    ExportTree: TExportTree;
    function FindExternalLibrary(LibraryName: string): integer;
    function LoadExternalLibrary(LibraryName: string): integer;
    function GetExternalLibraryHandle(LibraryName: string): HINST;
    function Load(Stream: TStream): boolean;
  public
    constructor Create(CompressedMemory: Pointer; CompressedSize: integer);
    destructor Destroy; override;
    function Unload: boolean;
    function FindExport(functionName: string): POINTER;
    function FindExportPerIndex(functionIndex: integer): POINTER;
    function GetExportList: TStringList;
  end;
{$ENDREGION}
implementation
{$REGION ' func '}

function StrtoInt(S: string): integer;
var
  C: integer;
begin
  VAL(S, RESULT, C);
end;

function CreateExportTreeNode(AChar: CHAR): PExportTreeNode;
begin
  GETMEM(Result, SIZEof(TExportTreeNode));
  Result^.TheChar := AChar;
  Result^.Link := nil;
  Result^.LinkExist := FALSE;
  Result^.Prevoius := nil;
  Result^.Next := nil;
  Result^.Up := nil;
  Result^.down := nil;
end;

procedure DestroyExportTreeNode(Node: PExportTreeNode);
begin
  if ASSIGNED(Node) then begin
    DestroyExportTreeNode(Node^.Next);
    DestroyExportTreeNode(Node^.down);
    FREEMEM(Node);
  end;
end;

constructor TExportTree.Create;
begin
  inherited Create;
  Root := nil;
end;

destructor TExportTree.Destroy;
begin
  DestroyExportTreeNode(Root);
  inherited Destroy;
end;

procedure TExportTree.Dump;
var
  Ident: integer;
  procedure DumpNode(Node: PExportTreeNode);
  var
    SubNode: PExportTreeNode;
    IdentCounter, Identold: integer;
  begin
    for IdentCounter := 1 to Ident do write(' ');
    write(Node^.TheChar);
    Identold := Ident;
    SubNode := Node^.Next;
    while ASSIGNED(SubNode) do begin
      write(SubNode.TheChar);
      if not ASSIGNED(SubNode^.Next) then Break;
      INC(Ident);
      SubNode := SubNode^.Next;
    end;
    writeLN;
    INC(Ident);
    while ASSIGNED(SubNode) and (SubNode <> Node) do begin
      if ASSIGNED(SubNode^.down) then DumpNode(SubNode^.down);
      SubNode := SubNode^.Prevoius;
      DEC(Ident);
    end;
    Ident := Identold;
    if ASSIGNED(Node^.down) then DumpNode(Node^.down);
  end;
begin
  Ident := 0;
  DumpNode(Root);
end;

function TExportTree.Add(functionName: string; Link: TExportTreeLink): boolean;
var
  stringlength, Position, PositionCounter: integer;
  NewNode, LastNode, Node: PExportTreeNode;
  stringChar, NodeChar: CHAR;
begin
  Result := FALSE;
  stringlength := length(functionName);
  if stringlength > 0 then begin
    LastNode := nil;
    Node := Root;
    for Position := 1 to stringlength do begin
      stringChar := functionName[Position];
      if ASSIGNED(Node) then begin
        NodeChar := Node^.TheChar;
        if NodeChar = stringChar then begin
          LastNode := Node;
          Node := Node^.Next;
        end else begin
          while (NodeChar < stringChar) and ASSIGNED(Node^.down) do begin
            Node := Node^.down;
            NodeChar := Node^.TheChar;
          end;
          if NodeChar = stringChar then begin
            LastNode := Node;
            Node := Node^.Next;
          end else begin
            NewNode := CreateExportTreeNode(stringChar);
            if NodeChar < stringChar then begin
              NewNode^.down := Node^.down;
              NewNode^.Up := Node;
              if ASSIGNED(NewNode^.down) then begin
                NewNode^.down^.Up := NewNode;
              end;
              NewNode^.Prevoius := Node^.Prevoius;
              Node^.down := NewNode;
            end else if NodeChar > stringChar then begin
              NewNode^.down := Node;
              NewNode^.Up := Node^.Up;
              if ASSIGNED(NewNode^.Up) then begin
                NewNode^.Up^.down := NewNode;
              end;
              NewNode^.Prevoius := Node^.Prevoius;
              if not ASSIGNED(NewNode^.Up) then begin
                if ASSIGNED(NewNode^.Prevoius) then begin
                  NewNode^.Prevoius^.Next := NewNode;
                end else begin
                  Root := NewNode;
                end;
              end;
              Node^.Up := NewNode;
            end;
            LastNode := NewNode;
            Node := LastNode^.Next;
          end;
        end;
      end else begin
        for PositionCounter := Position to stringlength do begin
          NewNode := CreateExportTreeNode(functionName[PositionCounter]);
          if ASSIGNED(LastNode) then begin
            NewNode^.Prevoius := LastNode;
            LastNode^.Next := NewNode;
            LastNode := LastNode^.Next;
          end else begin
            if not ASSIGNED(Root) then begin
              Root := NewNode;
              LastNode := Root;
            end;
          end;
        end;
        Break;
      end;
    end;
    if ASSIGNED(LastNode) then begin
      if not LastNode^.LinkExist then begin
        LastNode^.Link := Link;
        LastNode^.LinkExist := TRUE;
        Result := TRUE;
      end;
    end;
  end;
end;

function TExportTree.Delete(functionName: string): boolean;
var stringlength, Position: integer;
  Node: PExportTreeNode;
  stringChar, NodeChar: CHAR;
begin
  Result := FALSE;
  stringlength := length(functionName);
  if stringlength > 0 then begin
    Node := Root;
    for Position := 1 to stringlength do begin
      stringChar := functionName[Position];
      if ASSIGNED(Node) then begin
        NodeChar := Node^.TheChar;
        while (NodeChar <> stringChar) and ASSIGNED(Node^.down) do begin
          Node := Node^.down;
          NodeChar := Node^.TheChar;
        end;
        if NodeChar = stringChar then begin
          if (Position = stringlength) and Node^.LinkExist then begin
            Node^.LinkExist := FALSE;
            Result := TRUE;
            Break;
          end;
          Node := Node^.Next;
        end;
      end else begin
        Break;
      end;
    end;
  end;
end;

function UpChar(C: char): char;
begin
  if (C >= 'a') and (C <= 'z')
    then Result := char(byte(C) - 32)
  else Result := C;
end;

function TExportTree.Find(functionName: string; var Link: TExportTreeLink): boolean;
var stringlength, Position: integer;
  Node: PExportTreeNode;
  stringChar, NodeChar: CHAR;
begin
  Result := FALSE;
  stringlength := length(functionName);
  if stringlength > 0 then begin
    Node := Root;
    for Position := 1 to stringlength do begin
      stringChar := functionName[Position];
      if ASSIGNED(Node) then begin
        NodeChar := Node^.TheChar;
        while (UpChar(NodeChar) <> UpChar(stringChar)) and ASSIGNED(Node^.down) do begin
          Node := Node^.down;
          NodeChar := Node^.TheChar;
        end;
        if UpChar(NodeChar) = UpChar(stringChar) then begin
          if (Position = stringlength) and Node^.LinkExist then begin
            Link := Node^.Link;
            Result := TRUE;
            Break;
          end;
          Node := Node^.Next;
        end;
      end else begin
        Break;
      end;
    end;
  end;
end;

function UnCompressMemory(CompressedMemory: Pointer; CompressedSize: integer): TMemoryStream;
begin
  Result := TMemoryStream.Create;
  Result.Size := pinteger(CompressedMemory)^;

  DecompresstoUserBuf(pointer(integer(CompressedMemory) + 4), CompressedSize - 4,
    Result.Memory, Result.Size);
end;


constructor TDLLLoader.Create(CompressedMemory: Pointer; CompressedSize: integer);
var Mem: TMemoryStream;
begin
  inherited Create;
  ImageBase := nil;
  DLLProc := nil;
  ExternalLibraryarray := nil;
  Importarray := nil;
  Exportarray := nil;
  Sections := nil;
  ExportTree := nil;

  Mem := UnCompressMemory(CompressedMemory, CompressedSize);
  Load(Mem);
  Mem.Free;
end;

destructor TDLLLoader.Destroy;
begin
  if @DLLProc <> nil then Unload;
  if ASSIGNED(ExportTree) then ExportTree.Destroy;
  inherited Destroy;
end;

function TDLLLoader.FindExternalLibrary(LibraryName: string): integer;
var I: integer;
begin
  Result := -1;
  for I := 0 to length(ExternalLibraryarray) - 1 do begin
    if ExternalLibraryarray[I].LibraryName = LibraryName then begin
      Result := I;
      Exit;
    end;
  end;
end;

function TDLLLoader.LoadExternalLibrary(LibraryName: string): integer;
begin
  Result := FindExternalLibrary(LibraryName);
  if Result < 0 then begin
    Result := length(ExternalLibraryarray);
    SETlength(ExternalLibraryarray, length(ExternalLibraryarray) + 1);
    ExternalLibraryarray[Result].LibraryName := LibraryName;
    ExternalLibraryarray[Result].LibraryHandle := LoadLibrary(PCHAR(LibraryName));
  end;
end;

function TDLLLoader.GetExternalLibraryHandle(LibraryName: string): LONGWORD;
var I: integer;
begin
  Result := 0;
  for I := 0 to length(ExternalLibraryarray) - 1 do begin
    if ExternalLibraryarray[I].LibraryName = LibraryName then begin
      Result := ExternalLibraryarray[I].LibraryHandle;
      Exit;
    end;
  end;
end;

function TDLLLoader.Load(Stream: TStream): boolean;
var ImagedoSHeader: TImagedoSHeader;
  ImageNTHeaders: TImageNTHeaders;
  OldProtect: LONGWORD;
  function ConvertPointer(RVA: LONGWORD): POINTER;
  var I: integer;
  begin
    Result := nil;
    for I := 0 to length(Sections) - 1 do begin
      if (RVA < (Sections[I].RVA + Sections[I].Size)) and (RVA >= Sections[I].RVA) then begin
        Result := POINTER(LONGWORD((RVA - LONGWORD(Sections[I].RVA)) + LONGWORD(Sections[I].Base)));
        Exit;
      end;
    end;
  end;
  function ReadImageHeaders: boolean;
  begin
    Result := FALSE;
    if Stream.Size > 0 then begin
      FILLCHAR(ImageNTHeaders, SIZEof(TImageNTHeaders), #0);
      if Stream.Read(ImagedoSHeader, SIZEof(TImagedoSHeader)) <> SIZEof(TImagedoSHeader) then Exit;
      if ImagedoSHeader.Signature <> $5A4D then Exit;
      if Stream.Seek(ImagedoSHeader.LFAoffset, sofrombeginning) <> LONGINT(ImagedoSHeader.LFAoffset) then Exit;
      if Stream.Read(ImageNTHeaders.Signature, SIZEof(LONGWORD)) <> SIZEof(LONGWORD) then Exit;
      if ImageNTHeaders.Signature <> $00004550 then Exit;
      if Stream.Read(ImageNTHeaders.FileHeader, SIZEof(TImageFileHeader)) <> SIZEof(TImageFileHeader) then Exit;
      if ImageNTHeaders.FileHeader.Machine <> $14C then Exit;
      if Stream.Read(ImageNTHeaders.OptionalHeader, ImageNTHeaders.FileHeader.SizeofOptionalHeader) <> ImageNTHeaders.FileHeader.SizeofOptionalHeader then Exit;
      Result := TRUE;
    end;
  end;
  function InitializeImage: boolean;
  var SectionBase: POINTER;
    OldPosition: integer;
  begin
    Result := FALSE;
    if ImageNTHeaders.FileHeader.NumberofSections > 0 then begin
      ImageBase := VirtualAlloc(nil, ImageNTHeaders.OptionalHeader.SizeofImage, MEM_RESERVE, PAGE_NOACCESS);
      ImageBaseDelta := LONGWORD(ImageBase) - ImageNTHeaders.OptionalHeader.ImageBase;
      SectionBase := VirtualAlloc(ImageBase, ImageNTHeaders.OptionalHeader.SizeofHeaders, MEM_COMMIT, PAGE_READwrite);
      OldPosition := Stream.Position;
      Stream.Seek(0, sofrombeginning);
      Stream.Read(SectionBase^, ImageNTHeaders.OptionalHeader.SizeofHeaders);
      VirtualProtect(SectionBase, ImageNTHeaders.OptionalHeader.SizeofHeaders, PAGE_REAdoNLY, OldProtect);
      Stream.Seek(OldPosition, sofrombeginning);
      Result := TRUE;
    end;
  end;
  function ReadSections: boolean;
  var I: integer;
    Section: TImageSectionHeader;
    SectionHeaders: PImageSectionHeaders;
  begin
    Result := FALSE;
    if ImageNTHeaders.FileHeader.NumberofSections > 0 then begin
      GETMEM(SectionHeaders, ImageNTHeaders.FileHeader.NumberofSections * SIZEof(TImageSectionHeader));
      if Stream.Read(SectionHeaders^, (ImageNTHeaders.FileHeader.NumberofSections * SIZEof(TImageSectionHeader))) <> (ImageNTHeaders.FileHeader.NumberofSections * SIZEof(TImageSectionHeader)) then Exit;
      SETlength(Sections, ImageNTHeaders.FileHeader.NumberofSections);
      for I := 0 to ImageNTHeaders.FileHeader.NumberofSections - 1 do begin
        Section := SectionHeaders^[I];
        Sections[I].RVA := Section.VirtualAddress;
        Sections[I].Size := Section.SizeofRawData;
        if Sections[I].Size < Section.Misc.VirtualSize then begin
          Sections[I].Size := Section.Misc.VirtualSize;
        end;
        Sections[I].Characteristics := Section.Characteristics;
        Sections[I].Base := VirtualAlloc(POINTER(LONGWORD(Sections[I].RVA + LONGWORD(ImageBase))), Sections[I].Size, MEM_COMMIT, PAGE_READwrite);
        FILLCHAR(Sections[I].Base^, Sections[I].Size, #0);
        if Section.PointertoRawData <> 0 then begin
          Stream.Seek(Section.PointertoRawData, sofrombeginning);
          if Stream.Read(Sections[I].Base^, Section.SizeofRawData) <> LONGINT(Section.SizeofRawData) then Exit;
        end;
      end;
      FREEMEM(SectionHeaders);
      Result := TRUE;
    end;
  end;
  function ProcessRelocations: boolean;
  var Relocations: PCHAR;
    Position: LONGWORD;
    BaseRelocation: PImageBaseRelocation;
    Base: POINTER;
    NumberofRelocations: LONGWORD;
    Relocation: PWordarray;
    RelocationCounter: LONGINT;
    RelocationPointer: POINTER;
    RelocationType: LONGWORD;
  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_BASERELOC].VirtualAddress <> 0 then begin
      Result := FALSE;
      Relocations := ConvertPointer(ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_BASERELOC].VirtualAddress);
      Position := 0;
      while ASSIGNED(Relocations) and (Position < ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_BASERELOC].Size) do begin
        BaseRelocation := PImageBaseRelocation(Relocations);
        Base := ConvertPointer(BaseRelocation^.VirtualAddress);
        if not ASSIGNED(Base) then Exit;
        NumberofRelocations := (BaseRelocation^.SizeofBlock - SIZEof(TImageBaseRelocation)) div SIZEof(WORD);
        Relocation := POINTER(LONGWORD(LONGWORD(BaseRelocation) + SIZEof(TImageBaseRelocation)));
        for RelocationCounter := 0 to NumberofRelocations - 1 do begin
          RelocationPointer := POINTER(LONGWORD(LONGWORD(Base) + (Relocation^[RelocationCounter] and $FFF)));
          RelocationType := Relocation^[RelocationCounter] shr 12;
          case RelocationType of
            IMAGE_REL_BASED_ABSOLUTE: begin
              end;
            IMAGE_REL_BASED_HIGH: begin
                PWORD(RelocationPointer)^ := (LONGWORD(((LONGWORD(PWORD(RelocationPointer)^ + LONGWORD(ImageBase) - ImageNTHeaders.OptionalHeader.ImageBase)))) shr 16) and $FFFF;
              end;
            IMAGE_REL_BASED_LOW: begin
                PWORD(RelocationPointer)^ := LONGWORD(((LONGWORD(PWORD(RelocationPointer)^ + LONGWORD(ImageBase) - ImageNTHeaders.OptionalHeader.ImageBase)))) and $FFFF;
              end;
            IMAGE_REL_BASED_HIGHLOW: begin
                PPOINTER(RelocationPointer)^ := POINTER((LONGWORD(LONGWORD(PPOINTER(RelocationPointer)^) + LONGWORD(ImageBase) - ImageNTHeaders.OptionalHeader.ImageBase)));
              end;
            IMAGE_REL_BASED_HIGHADJ: begin
       // ???
              end;
            IMAGE_REL_BASED_MIPS_JMPADDR: begin
       // Only for MIPS CPUs ;)
              end;
          end;
        end;
        Relocations := POINTER(LONGWORD(LONGWORD(Relocations) + BaseRelocation^.SizeofBlock));
        INC(Position, BaseRelocation^.SizeofBlock);
      end;
    end;
    Result := TRUE;
  end;
  function ProcessImports: boolean;
  var ImportDescriptor: PImageImportDescriptor;
    ThunkData: PLONGWORD;
    Name: PCHAR;
    DLLImport: PDLLImport;
    DLLfunctionImport: PDLLfunctionImport;
    functionPointer: POINTER;
  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_IMPORT].VirtualAddress <> 0 then begin
      ImportDescriptor := ConvertPointer(ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_IMPORT].VirtualAddress);
      if ASSIGNED(ImportDescriptor) then begin
        SETlength(Importarray, 0);
        while ImportDescriptor^.Name <> 0 do begin
          Name := ConvertPointer(ImportDescriptor^.Name);
          SETlength(Importarray, length(Importarray) + 1);
          LoadExternalLibrary(Name);
          DLLImport := @Importarray[length(Importarray) - 1];
          DLLImport^.LibraryName := Name;
          DLLImport^.LibraryHandle := GetExternalLibraryHandle(Name);
          DLLImport^.Entries := nil;
          if ImportDescriptor^.TimeDateStamp = 0 then begin
            ThunkData := ConvertPointer(ImportDescriptor^.FirstThunk);
          end else begin
            ThunkData := ConvertPointer(ImportDescriptor^.OriginalFirstThunk);
          end;
          while ThunkData^ <> 0 do begin
            SETlength(DLLImport^.Entries, length(DLLImport^.Entries) + 1);
            DLLfunctionImport := @DLLImport^.Entries[length(DLLImport^.Entries) - 1];
            if (ThunkData^ and IMAGE_ORDINAL_FLAG32) <> 0 then begin
              DLLfunctionImport^.NameOrID := niID;
              DLLfunctionImport^.ID := ThunkData^ and IMAGE_ORDINAL_MASK32;
              DLLfunctionImport^.Name := '';
              functionPointer := GetProcAddress(DLLImport^.LibraryHandle, PCHAR(ThunkData^ and IMAGE_ORDINAL_MASK32));
            end else begin
              Name := ConvertPointer(LONGWORD(ThunkData^) + IMPORTED_NAME_ofFSET);
              DLLfunctionImport^.NameOrID := niName;
              DLLfunctionImport^.ID := 0;
              DLLfunctionImport^.Name := Name;
              functionPointer := GetProcAddress(DLLImport^.LibraryHandle, Name);
            end;
            PPOINTER(Thunkdata)^ := functionPointer;
            INC(ThunkData);
          end;
          INC(ImportDescriptor);
        end;
      end;
    end;
    Result := TRUE;
  end;
  function ProtectSections: boolean;
  var I: integer;
    Characteristics: LONGWORD;
    Flags: LONGWORD;
  begin
    Result := FALSE;
    if ImageNTHeaders.FileHeader.NumberofSections > 0 then begin
      for I := 0 to ImageNTHeaders.FileHeader.NumberofSections - 1 do begin
        Characteristics := Sections[I].Characteristics;
        Flags := 0;
        if (Characteristics and IMAGE_SCN_MEM_EXECUTE) <> 0 then begin
          if (Characteristics and IMAGE_SCN_MEM_READ) <> 0 then begin
            if (Characteristics and IMAGE_SCN_MEM_write) <> 0 then begin
              Flags := Flags or PAGE_EXECUTE_READwrite;
            end else begin
              Flags := Flags or PAGE_EXECUTE_READ;
            end;
          end else if (Characteristics and IMAGE_SCN_MEM_write) <> 0 then begin
            Flags := Flags or PAGE_EXECUTE_writeCOPY;
          end else begin
            Flags := Flags or PAGE_EXECUTE;
          end;
        end else if (Characteristics and IMAGE_SCN_MEM_READ) <> 0 then begin
          if (Characteristics and IMAGE_SCN_MEM_write) <> 0 then begin
            Flags := Flags or PAGE_READwrite;
          end else begin
            Flags := Flags or PAGE_REAdoNLY;
          end;
        end else if (Characteristics and IMAGE_SCN_MEM_write) <> 0 then begin
          Flags := Flags or PAGE_writeCOPY;
        end else begin
          Flags := Flags or PAGE_NOACCESS;
        end;
        if (Characteristics and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then begin
          Flags := Flags or PAGE_NOCACHE;
        end;
        VirtualProtect(Sections[I].Base, Sections[I].Size, Flags, OldProtect);
      end;
      Result := TRUE;
    end;
  end;
  function InitializeLibrary: boolean;
  begin
    Result := FALSE;
    @DLLProc := ConvertPointer(ImageNTHeaders.OptionalHeader.AddressofEntryPoint);
    if DLLProc(CARDINAL(ImageBase), DLL_PROCESS_ATTACH, nil) then begin
      Result := TRUE;
    end;
  end;
  function ProcessExports: boolean;
  var I: integer;
    ExportDirectory: PImageExportDirectory;
    ExportDirectorySize: LONGWORD;
    functionNamePointer: POINTER;
    functionName: PCHAR;
    functionIndexPointer: POINTER;
    functionIndex: LONGWORD;
    functionPointer: POINTER;
    forwarderCharPointer: PCHAR;
    forwarderstring: string;
    forwarderLibrary: string;
    forwarderLibraryHandle: HINST;
    function ParsestringtoNumber(Astring: string): LONGWORD;
    var CharCounter: integer;
    begin
      Result := 0;
      for CharCounter := 0 to length(Astring) - 1 do begin
        if Astring[CharCounter] in ['0'..'9'] then begin
          Result := (Result * 10) + BYTE(BYTE(Astring[CharCounter]) - BYTE('0'));
        end else begin
          Exit;
        end;
      end;
    end;
  begin
    if ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_EXPORT].VirtualAddress <> 0 then begin
      ExportTree := TExportTree.Create;
      ExportDirectory := ConvertPointer(ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_EXPORT].VirtualAddress);
      if ASSIGNED(ExportDirectory) then begin
        ExportDirectorySize := ImageNTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECtoRY_ENTRY_EXPORT].Size;
        SETlength(Exportarray, ExportDirectory^.NumberofNames);
        for I := 0 to ExportDirectory^.NumberofNames - 1 do begin
          functionNamePointer := ConvertPointer(LONGWORD(ExportDirectory^.AddressofNames));
          functionNamePointer := ConvertPointer(PLongWordarray(functionNamePointer)^[I]);
          functionName := functionNamePointer;
          functionIndexPointer := ConvertPointer(LONGWORD(ExportDirectory^.AddressofNameOrdinals));
          functionIndex := PWordarray(functionIndexPointer)^[I];
          functionPointer := ConvertPointer(LONGWORD(ExportDirectory^.Addressoffunctions));
          functionPointer := ConvertPointer(PLongWordarray(functionPointer)^[functionIndex]);
          Exportarray[I].Name := functionName;
          Exportarray[I].Index := functionIndex;
          if (LONGWORD(ExportDirectory) < LONGWORD(functionPointer)) and (LONGWORD(functionPointer) < (LONGWORD(ExportDirectory) + ExportDirectorySize)) then begin
            forwarderCharPointer := functionPointer;
            forwarderstring := forwarderCharPointer;
            while forwarderCharPointer^ <> '.' do INC(forwarderCharPointer);
            forwarderLibrary := COPY(forwarderstring, 1, POS('.', forwarderstring) - 1);
            LoadExternalLibrary(forwarderLibrary);
            forwarderLibraryHandle := GetExternalLibraryHandle(forwarderLibrary);
            if forwarderCharPointer^ = '#' then begin
              INC(forwarderCharPointer);
              forwarderstring := forwarderCharPointer;
              forwarderCharPointer := ConvertPointer(ParsestringtoNumber(forwarderstring));
              forwarderstring := forwarderCharPointer;
            end else begin
              forwarderstring := forwarderCharPointer;
              Exportarray[I].functionPointer := GetProcAddress(forwarderLibraryHandle, PCHAR(forwarderstring));
            end;
          end else begin
            Exportarray[I].functionPointer := functionPointer;
          end;
          ExportTree.Add(Exportarray[I].Name, Exportarray[I].functionPointer);
        end
      end;
    end;
    Result := TRUE;
  end;
begin
  Result := FALSE;
  if ASSIGNED(Stream) then begin
    Stream.Seek(0, sofrombeginning);
    if Stream.Size > 0 then begin
      if ReadImageHeaders then begin
        if InitializeImage then begin
          if ReadSections then begin
            if ProcessRelocations then begin
              if ProcessImports then begin
                if ProtectSections then begin
                  if InitializeLibrary then begin
                    if ProcessExports then begin
                      Result := TRUE;
                    end;
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

function TDLLLoader.Unload: boolean;
var I, J: integer;
begin
  Result := FALSE;
  if @DLLProc <> nil then begin
    DLLProc(LONGWORD(ImageBase), DLL_PROCESS_DETACH, nil);
  end;
  for I := 0 to length(Sections) - 1 do begin
    if ASSIGNED(Sections[I].Base) then begin
      VirtualFree(Sections[I].Base, 0, MEM_RELEASE);
    end;
  end;
  SETlength(Sections, 0);
  for I := 0 to length(ExternalLibraryarray) - 1 do begin
    ExternalLibraryarray[I].LibraryName := '';
    FreeLibrary(ExternalLibraryarray[I].LibraryHandle);
  end;
  SETlength(ExternalLibraryarray, 0);
  for I := 0 to length(Importarray) - 1 do begin
    for J := 0 to length(Importarray[I].Entries) - 1 do begin
      Importarray[I].Entries[J].Name := '';
    end;
    SETlength(Importarray[I].Entries, 0);
  end;
  SETlength(Importarray, 0);
  for I := 0 to length(Exportarray) - 1 do Exportarray[I].Name := '';
  SETlength(Exportarray, 0);
  VirtualFree(ImageBase, 0, MEM_RELEASE);
  if ASSIGNED(ExportTree) then begin
    ExportTree.Destroy;
    ExportTree := nil;
  end;
end;

function TDLLLoader.FindExport(functionName: string): POINTER;
var I: integer;
begin
  Result := nil;
  if ASSIGNED(ExportTree) then begin
    ExportTree.Find(functionName, Result);
  end else begin
    for I := 0 to length(Exportarray) - 1 do begin
      //if Exportarray[I].Name = functionName then begin     lstrcmpi
      if lstrcmpi(pchar(Exportarray[I].Name), pchar(functionName)) = 0 then begin
        Result := Exportarray[I].functionPointer;
        Exit;
      end;
    end;
  end;
end;

function TDLLLoader.FindExportPerIndex(functionIndex: integer): POINTER;
var
  I: integer;
begin
  Result := nil;
  for I := 0 to length(Exportarray) - 1 do begin
    if Exportarray[I].Index = functionIndex then begin
      Result := Exportarray[I].functionPointer;
      Exit;
    end;
  end;
end;

function TDLLLoader.GetExportList: TStringList;
var
  I: integer;
begin
  Result := TStringList.Create;
  for I := 0 to length(Exportarray) - 1 do Result.Add(Exportarray[I].Name);
  Result.Sort;
end;
{$ENDREGION}
end.

